library(here)
library(tidyverse)
source(here("utils.R"))
source(here("experiments", "blocksworld-main", "analysis", "model-utils.R"))
target_dir <- here("experiments", "blocksworld-main", "results", "data-raw")
Anonymize data once
save_raw_without_prolific_id(target_dir, "results_13_blocksWorld-main_BG.csv",
"13_blocksWorld-main_BG")
## Parsed with column specification:
## cols(
## .default = col_character(),
## submission_id = col_double(),
## age = col_double(),
## endTime = col_double(),
## experiment_id = col_double(),
## question = col_logical(),
## startTime = col_double(),
## timeSpent = col_double(),
## trial_number = col_double()
## )
## See spec(...) for full column specifications.
fn <- paste(target_dir, "results_anonymized_13_blocksWorld-main_BG.csv",
sep=.Platform$file.sep)
data <- preprocess_data(fn)
## [1] "read data from: /home/britta/UNI/Osnabrueck/conditionals-blocksworld/experiments/blocksworld-main/results/data-raw/results_anonymized_13_blocksWorld-main_BG.csv"
## Parsed with column specification:
## cols(
## .default = col_character(),
## submission_id = col_double(),
## age = col_double(),
## endTime = col_double(),
## experiment_id = col_double(),
## question = col_logical(),
## startTime = col_double(),
## timeSpent = col_double(),
## trial_number = col_double()
## )
## See spec(...) for full column specifications.
## Warning: Expected 4 pieces. Missing pieces filled with `NA` in 200 rows
## [1, 2, 3, 4, 30, 31, 32, 33, 59, 60, 61, 62, 88, 89, 90, 91, 117, 118, 119,
## 120, ...].
# discard train data
data <- data %>% filter(trial_name == "slider_main")
nrow(data)
## [1] 5000
STIMULI <- data %>% ungroup() %>% pull(stimulus_id) %>% unique()
e.g. time, age, gender
# duration
df <- data %>% ungroup() %>% select(participant_id, timeSpent, age, gender,
utterance, response, stimulus_id) %>%
group_by(participant_id) %>% distinct()
df %>% ungroup() %>% select(timeSpent, age, gender) %>% distinct() %>%
summary()
## timeSpent age gender
## Min. : 7.927 Min. :19.00 female:32
## 1st Qu.:11.835 1st Qu.:28.50 male :16
## Median :15.886 Median :35.50 other : 2
## Mean :16.888 Mean :37.72
## 3rd Qu.:20.392 3rd Qu.:46.00
## Max. :35.117 Max. :68.00
df <- data %>%
select(stimulus_id, participant_id, RT, utterance) %>%
pivot_wider(names_from = utterance, values_from = RT) %>%
pivot_longer(cols = c("b", "g", "bg", "gb"), names_to = "utterance",
values_to = "RT") %>%
group_by(stimulus_id, utterance) %>%
mutate(sd_rt=sd(RT), RT=mean(RT), RT=mean(RT)) %>%
select(-participant_id) %>%
distinct()
p <- df %>% ggplot(aes(x=stimulus_id, y=RT, fill=utterance)) +
geom_bar(position="dodge", stat="identity") +
theme(legend.position="bottom", axis.text.x = element_text(angle=90)) +
ggtitle('Average Reaction Times per stimulus') +
geom_hline(aes(yintercept = mean(df$RT)))
p
dat.comments <- data %>% ungroup() %>% select(comments, participant_id)
dat.comments %>% select(comments) %>% unique()
c <- dat.comments %>% filter(str_detect(comments, "Initially.*")) %>% distinct()
pid <- c %>% pull(participant_id)
c %>% pull(comments)
## [1] "Initially, I was glossing over the fact that the \"if\" statements were wrong. I was answering affirmatively if they ensconced the falling of both bricks for example, if they were both expected to fall. Eventually, I realized that I should be answering in the negative when the statement contained false consequences. (What this brick does has nothing to do with what that one does.)"
Account for different color-groups
# match colors and blocks depending on color-group
data_processed <- data %>%
group_by(participant_id, stimulus_id, color_group) %>%
mutate(utterance = case_when(color_group=="group1" & utterance=="b" ~ "A",
color_group=="group1" & utterance=="g" ~ "C",
color_group=="group1" & utterance=="bg" ~ "A > C",
color_group=="group1" & utterance=="gb" ~ "C > A",
color_group=="group2" & utterance=="b" ~ "C",
color_group=="group2" & utterance=="g" ~ "A",
color_group=="group2" & utterance=="bg" ~ "C > A",
color_group=="group2" & utterance=="gb" ~ "A > C"
),
utterance=factor(utterance, levels = c("A", "C", "A > C", "C > A")),
response = response/100) %>%
ungroup() %>% select(-color_group)
Discard irrelevant columns
data_processed <- data_processed %>% select(-RT, -trial_name, -timeSpent,
-gender, -age, -utt_idx)
Are there any unacceptable trials?
# participants who didn't accept any utterance at all
data_filtered <- data_processed %>% group_by(participant_id, trial_number) %>%
mutate(s=sum(response)) %>% filter(s!=0) %>% select(-s)
nrow(data_filtered)
## [1] 4848
Check for critical trials where minimal requirements are not fulfilled.
If at least one block clearly touches or clearly doesn’t touch the ground, but participant put low/high probability on utterance “A/C will touch the ground”, discard trial, in these cases participants cannot have been concentrated. To check this, use normalized data!
Again, control trials seem to be necessary to avoid this.
df <- data_filtered %>%
group_by(participant_id, stimulus_id) %>%
filter(sum(response) != 0)
nrow(df)
## [1] 4848
data_normalized <- df %>% mutate(n=sum(response), response.norm=response/n) %>%
select(-response)
The following picture show the scenes for which requirements were specified.
“S12-203”
“S22-468”
“S30-805”
“S32-806”
“S57-1007”
“S7-130”
fn <- "scenes_luh_annotations.csv"
min.require <- read_csv(here("experiments", "stimuli", fn)) %>%
select(req.exp2.not.small, req.exp2.not.large, id) %>%
filter((!is.na(req.exp2.not.small) | !is.na(req.exp2.not.large)))
data_normalized_wide <- data_normalized %>%
select(-trial_number) %>%
group_by(participant_id, stimulus_id) %>%
pivot_wider(names_from = utterance, values_from = response.norm)
check <- function(data_wide, stimulus){
req <- min.require %>% filter(id== (!!stimulus))
dat <- tibble()
if(nrow(req) != 0){
not_small <- req$`req.exp2.not.small`
not_large <- req$`req.exp2.not.large`
dat <- data_wide %>% filter(stimulus_id==(!!stimulus))
if(!is.na(not_small)) {
if(str_detect(not_small, "A.*")){
dat <- dat %>% filter(A < 0.2)
if(not_small == "A_C"){
dat <- dat %>% filter(C < 0.2)
}
}
dat <- dat %>% filter(C < 0.2)
}
if(!is.na(not_large)){
if(str_detect(not_large, "A.*")){
dat <- dat %>% filter(A > 0.8)
if(not_large == "A_C"){
dat <- dat %>% filter(C > 0.8)
}
}
dat <- dat %>% filter(C > 0.8)
}
}
return(dat)
}
critical <- tibble()
for (s in STIMULI){
t <- check(data_normalized_wide, s)
critical <- bind_rows(critical, t)
}
critical
data_normalized <- anti_join(data_normalized_wide, critical) %>%
pivot_longer(cols = c("A", "C", "A > C", "C > A"), names_to = "utterance",
values_to = "response")
# undo normalization
data_filtered <- data_normalized %>% mutate(response=response*n)
nrow(data_filtered)
## [1] 4848
Filter if something went wrong according to comments
# filter if-trials for that participant
data_filtered <- data_filtered %>%
filter(participant_id != pid | (utterance=="A" | utterance =="C"))
data_filtered <- data_filtered %>%
select(-comments, -n) %>%
ungroup() %>%
mutate(utterance=factor(utterance)) %>%
group_by(stimulus_id, participant_id) %>%
arrange(participant_id, stimulus_id, utterance, response)
nrow(data_filtered)
## [1] 4808
nrow(data_filtered) / nrow(data)
## [1] 0.9616
dir_name <- here("experiments", "blocksworld-main", "results", "data-processed")
dir.create(dir_name, showWarnings=FALSE, recursive = TRUE)
save_to <- paste(dir_name, "data_experimental.csv", sep=.Platform$file.sep)
write.table(data_filtered , file = save_to, sep = ",", row.names=FALSE)
means <- data_filtered %>% group_by(stimulus_id, utterance) %>%
summarise(mean=mean(response))
fn <- "data_experimental_means.csv"
save_to <- paste(dir_name, fn, sep=.Platform$file.sep)
write.table(means, file = save_to, sep = ",", row.names=FALSE)
# Also save a normalized version of the data, such that all four responses
# (slider values) sum up to 1.
fn <- "data_experimental_normalized.csv"
save_to <- paste(dir_name, fn, sep=.Platform$file.sep)
write.table(data_normalized , file = save_to, sep = ",", row.names=FALSE)
means <- data_normalized %>% group_by(stimulus_id, utterance) %>%
summarise(mean=mean(response))
fn <- "data_experimental_normalized_means.csv"
save_to <- paste(dir_name, fn, sep=.Platform$file.sep)
write.table(means, file = save_to, sep = ",", row.names=FALSE)
labels <- c(`A > C`="If blue, green", A = "Blue will ttg", C="Green will ttg",
`C > A` = "If green, blue")
dir_name <- here("experiments", "blocksworld-main", "results", "plots")
dir.create(dir_name, showWarnings=FALSE, recursive = TRUE)
for (s in STIMULI){
df <- data_filtered %>% filter(stimulus_id == s)
df_means <- df %>% group_by(utterance) %>%
summarise(m=mean(response), med=median(response))
p <- df %>%
ggplot(aes(x=factor(0), y=response, fill=utterance)) +
geom_violin(alpha=0.5) +
geom_jitter(width = 0.2, alpha=0.5) +
geom_point(data=df_means, mapping=aes(x = factor(0), y = m), col="red") +
geom_point(data=df_means, mapping=aes(x=factor(0), y=med), col="yellow") +
coord_flip() +
labs(y="", x="") +
theme_classic() +
facet_wrap(~utterance, labeller = labeller(utterance=labels)) +
# ggtitle(s) +
theme(legend.position = "none", text = element_text(size=20),
axis.text.y=element_blank(), axis.ticks.y =element_blank(),
panel.spacing = unit(2, "lines"))
fn <- paste("responses-", s, ".jpg", sep="")
ggsave(paste(dir_name, fn, sep=.Platform$file.sep), p, width=5, height=4)
print(p)
}